(use-modules
 ;; text io
 (ice-9 textual-ports)
 ;; parsing
 (ice-9 peg)
 ;; structs
 (srfi srfi-9)
 ;; for functional structs (not part of srfi-9 directly)
 (srfi srfi-9 gnu)
 ;; for receive form
 (srfi srfi-8))

;; =======
;; GRAMMAR
;; =======

;; define a parser for the lines of input
(define-peg-pattern SEP none (+ " "))

(define-peg-pattern INDEX none (and "#" NUM))
(define-peg-pattern NUM body (+ DIGIT))
(define-peg-pattern DIGIT body (or "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))

(define-peg-pattern SQUARE_DEF all
  (and INDEX SEP "@" SEP
       UPPER_LEFT_CORNER ":" SEP
       DIMENSIONS))

(define-peg-pattern UPPER_LEFT_CORNER all
  (and X_COORD "," Y_COORD))

(define-peg-pattern X_COORD all NUM)
(define-peg-pattern Y_COORD all NUM)

(define-peg-pattern DIMENSIONS all
  (and WIDTH "x" HEIGHT))

(define-peg-pattern WIDTH all NUM)
(define-peg-pattern HEIGHT all NUM)

;; ================
;; DATA ABSTRACTION
;; ================

(define get-from-tree
  (λ (tree key)
    (cond
     [(null? tree) #f]
     [(eq? key (car tree))
      (cdr tree)]
     [(pair? (car tree))
      (or (get-from-tree (car tree) key)
          (get-from-tree (cdr tree) key))]

     [else
      (get-from-tree (cdr tree) key)])))


(define get-x-coord
  (λ (tree)
    (string->number (car (get-from-tree tree 'X_COORD)))))


(define get-y-coord
  (λ (tree)
    (string->number (car (get-from-tree tree 'Y_COORD)))))


(define get-upper-left-corner
  (λ (match-rec)
    (let ([tree (peg:tree match-rec)])
      (let ([ul-corner (get-from-tree tree 'UPPER_LEFT_CORNER)])
        ;; (display (simple-format #f "ul corner: ~a\n" ul-corner))
        (let ([x (get-x-coord ul-corner)]
              [y (get-y-coord ul-corner)])
          (cons x y))))))


(define get-width
  (λ (tree)
    (string->number (car (get-from-tree tree 'WIDTH)))))


(define get-height
  (λ (tree)
    (string->number (car (get-from-tree tree 'HEIGHT)))))


(define get-dimensions
  (λ (match-rec)
    (let ([tree (peg:tree match-rec)])
      (let ([dimensions (get-from-tree tree 'DIMENSIONS)])
        ;; (display (simple-format #f "dimensions: ~a\n" dimensions))
        (let ([w (get-width dimensions)]
              [h (get-height dimensions)])
          (cons w h))))))


(define-immutable-record-type <rect>
  ;; define constructor
  (rect x1 y1 x2 y2)
  ;; define predicate
  rect?
  ;; define accessors
  (x1 rect-x1)
  (y1 rect-y1)
  (x2 rect-x2)
  (y2 rect-y2))


(define make-rect
  (λ (upper-left-corner dimensions)
    (rect (car upper-left-corner)
          (cdr upper-left-corner)
          (+ (car upper-left-corner) (car dimensions))
          (+ (cdr upper-left-corner) (cdr dimensions)))))

;; =============
;; IO PROCEDURES
;; =============

(define* (get-lines-from-file file-path #:key (encoding "UTF-8"))
  ;; another common encoding is: "ISO-8859-1"
  ;; see http://www.iana.org/assignments/character-sets for more
  (define (get-lines-from-port port)
    (let ([line (get-line port)])
      (cond [(eof-object? line) '()]
            [else
             (cons line
                   (get-lines-from-port port))])))
  (call-with-input-file file-path
    (lambda (port)
      (set-port-encoding! port encoding)
      (get-lines-from-port port))))


(define parse-line
  (lambda (line-as-string)
    (match-pattern SQUARE_DEF line-as-string)))


(define read-input
  (lambda (file-path)
    (let ([lines (get-lines-from-file file-path)])
      (let ([match-records
             (map (lambda (line) (parse-line line))
                  lines)])
        (map (λ (match-rec)
               (make-rect (get-upper-left-corner match-rec)
                          (get-dimensions match-rec)))
             match-records)))))


;; ==========
;; MAIN LOGIC
;; ==========

(define find-min-and-max
  (λ (rects)
    (let loop ([remaining-rects rects]
               [min-x +inf.0]
               [min-y +inf.0]
               [max-x -inf.0]
               [max-y -inf.0])
      (cond
       [(null? remaining-rects)
        (values (inexact->exact min-x)
                (inexact->exact min-y)
                (inexact->exact max-x)
                (inexact->exact max-y))]
       [else
        (let ([current-rect (car remaining-rects)])
          (loop (cdr remaining-rects)
                (min min-x (rect-x1 current-rect))
                (min min-y (rect-y1 current-rect))
                (max max-x (rect-x2 current-rect))
                (max max-y (rect-y2 current-rect))))]))))


(define coord-in-rect?
  (λ (coord rect)
    (let ([x (car coord)]
          [y (cdr coord)])
    (and
     (and (>= x (rect-x1 rect)) (< x (rect-x2 rect)))
     (and (>= y (rect-y1 rect)) (< y (rect-y2 rect)))))))


(define main
  (λ (input-path)
    ;; NOTE: This code is shit. There is a better solution, but I am too lazy to
    ;; get into the topic to understand it. Search for "area of overlapping
    ;; rectangles".
    (define all-rects (read-input "input-01.txt"))

    ;; calculate the minima and maxima of x and y
    (receive (min-x min-y max-x max-y) (find-min-and-max all-rects)
      ;; (display (simple-format #f "~a ~a ~a ~a\n" min-x min-y max-x max-y))
      (let loop-y ([y min-y]
                   [conflicting-claims-count 0])

        (display (simple-format #f "y coordinate: ~a\n" y))
        (display (simple-format #f "confictingly claimed unit areas: ~a\n" conflicting-claims-count))

        (cond
         [(<= y max-y)
          (loop-y (+ y 1)
                  (let loop-x ([x min-x]
                               [conflicting-claims-count conflicting-claims-count])
                    (cond
                     [(<= x max-x)
                      (loop-x (+ 1 x)
                              (let loop-rects ([remaining-rects all-rects]
                                               [conflicting-claims-count conflicting-claims-count]
                                               [previously-claimed #f])
                                (cond
                                 ;; If there are no more rectangles to check,
                                 ;; return the conflict count.
                                 [(null? remaining-rects) conflicting-claims-count]
                                 ;; If the current coordinate x y is inside the rectanle, ...
                                 [(coord-in-rect? (cons x y) (car remaining-rects))
                                  (cond
                                   ;; ... check, whether it was already in
                                   ;; another rectangle and if that is the case
                                   ;; ...
                                   [previously-claimed
                                    #;(display
                                     (simple-format
                                      #f "found a conflictingly claimed coordinate: x:~a y:~a\n"
                                      x y))
                                    ;; ... return the incremented conflict
                                    ;; count.
                                    (+ conflicting-claims-count 1)]
                                   [else
                                    ;; If the coordinate is inside the
                                    ;; rectangle, but there has not been a
                                    ;; previous claim to that coordinate
                                    ;; continue with the next rectangle.
                                    (loop-rects (cdr remaining-rects)
                                                conflicting-claims-count
                                                #t)])]
                                 ;; If the coordinate is not inside the
                                 ;; rectangle, continue with the next rectangle.
                                 [else
                                  (loop-rects (cdr remaining-rects)
                                              conflicting-claims-count
                                              previously-claimed)])))]
                     [else conflicting-claims-count])))]
         [else conflicting-claims-count])))))


(main "input-01.txt")
